home *** CD-ROM | disk | FTP | other *** search
/ The Datafile PD-CD 1 Issue 2 / PDCD-1 - Issue 02.iso / _printapps / printapps / _oneprint / !ONEPRINT / SOURCE < prev    next >
Text File  |  1991-03-29  |  29KB  |  963 lines
  1. REM >Source
  2. REM Program One Print
  3. REM Version 1.00
  4. REM Author Geoff Titmuss
  5. REM ⌐ Ivoryash Limited 1991
  6. REM Program Subject to Copyright
  7.  
  8. ver$ = "1.00 (1 April 1991)"
  9. ON ERROR VDU4:PRINT REPORT$;" at line ";ERL;" - press a key":in=GET:PROCstop
  10.  
  11. REM To add a new printer, increment Makes by 1, and add an extra initial
  12. REM value on the line Makes()=...
  13. REM Then add another IF THEN ... ENDIF block in PROCsetcodes, but with
  14. REM your printer control codes.
  15.  
  16. Makes=2                :REM number of printer types
  17. DIM Make$(Makes)
  18. Make$()="Star NL10","Cannon BJ10e","Epson FX80"
  19.  
  20. h%=OPENIN("<Obey$Dir>.Printer") :REM get default printer
  21. Printer$=GET$#h%
  22. CLOSE#h%
  23.  
  24. L%=0                   :REM clear global variable - left margin
  25. R%=0                   :REM clear global variable - right margin
  26. lines = 1              :REM number of entry lines on screen
  27.  
  28. PROCwimp               :REM set up wimp environment
  29.  
  30. REM Main loop *****************************************
  31.  
  32. ON ERROR PROCerror
  33.  
  34. REPEAT
  35.   SYS "Wimp_Poll",,b TO reason
  36.   CASE reason OF
  37.     WHEN 2:    b!24=0                     :REM don't allow scroll
  38.                SYS "Wimp_OpenWindow",,b   :REM Open window request
  39.                IF !b=entry: PROCresize
  40.     WHEN 3:    SYS "Wimp_CloseWindow",,b  :REM Close window request
  41.     WHEN 6:    PROCbuttons(b)             :REM Mouse button change
  42.     WHEN 7:    PROCdragdone               :REM User drag box
  43.     WHEN 8:    PROCkey                    :REM Key pressed
  44.     WHEN 9:    PROCmenuselect(b)          :REM Menu select
  45.     WHEN 17,18:PROCreceive(b)             :REM General message
  46.     WHEN 19:   PROCnoack(b)               :REM Request not acknowledged
  47.   ENDCASE
  48. UNTIL quit
  49.  
  50. PROCstop
  51. END
  52.  
  53. DEF PROCkey              :REM handle key presses
  54.   IF !b=entry THEN
  55.     CASE b!24 OF
  56.       WHEN 13         :PROCcaret(b!4, 1, TRUE)       :REM return pressed
  57.       WHEN &18E       :PROCcaret(b!4, 1, FALSE)      :REM up arrow
  58.       WHEN &18F       :PROCcaret(b!4,-1, FALSE)      :REM down arrow
  59.     ENDCASE
  60.   ENDIF
  61.  
  62.   IF !b=saveas AND b!24=13 :PROCsaveit($fname)   :REM return on save window
  63.  
  64.   SYS "Wimp_ProcessKey",b!24       :REM pass key on to other apps
  65. ENDPROC
  66.  
  67. DEF PROCcaret(icon, direction, right)  :REM move carrot in window
  68.   icon += direction
  69.   IF icon > lines-1 :icon = 0          :REM below bottom icon
  70.   IF icon < 0       :icon = lines-1    :REM above top icon
  71.    
  72.   IF right=FALSE THEN
  73.     SYS "Wimp_GetCaretPosition",,b
  74.     right = b!20
  75.   ENDIF
  76.  
  77.   right=FNmin(right, LEN( $(FNindir(entry, icon))))
  78.  
  79.   SYS "Wimp_SetCaretPosition",entry,icon,,,-1,right
  80. ENDPROC
  81.               
  82. REM resize input window - this is not trivial because I choose to
  83. REM put three buttons at the bottom of the screen, because this is
  84. REM easier and more intuitive than menu selection.  So, if the 
  85. REM window is sized, I have to remove all the icons, and then
  86. REM recreated the correct number of input lines. I then add the new
  87. REM buttons on the bottom. Sorry - it flickers a bit!
  88.  
  89. DEF PROCresize
  90.   SYS "Wimp_GetCaretPosition",,b   :REM remember where the carrot was.
  91.   CaretWin = !b
  92.   CaretIcon = b!4
  93.   CaretIndex = b!20
  94.  
  95.   !b = entry                       :REM find how big the window is.
  96.   SYS "Wimp_GetWindowState",,b
  97.   miny = b!8
  98.   maxy = b!16
  99.   sizex = b!12-b!4
  100.   sizey = b!16-b!8
  101.   ycount = ((sizey-top-bottom) DIV depth) -1  :REM number of input lines.
  102.  
  103.   IF (ycount=lines) AND (oldsizex=sizex): ENDPROC  :REM no change in size.
  104.  
  105.   FOR I%=0 TO ClearBox: PROCshut(I%): NEXT         :REM delete all icons.
  106.  
  107.   FOR I%=0 TO ycount-1                             :REM add new input lines.
  108.     temp = top+((I%+2)*depth)
  109.     temp = FNopen(TextIcon, sizex-20, -temp, -temp-depth, text+80*I%)      
  110.   NEXT
  111.   temp1 = top + ((ycount+1)*depth) + 65
  112.  
  113.   PrintBox   = FNopen(PrintIcon,   0, -temp1, -temp1-Depth, 0)
  114.   OptionsBox = FNopen(OptionsIcon, 0, -temp1, -temp1-Depth, 0)
  115.   ClearBox   = FNopen(ClearIcon,   0, -temp1, -temp1-Depth, 0)
  116.  
  117.   PROCredraw(entry, FALSE)        :REM this makes changes visible
  118.   lines = ycount                  :REM number of input lines
  119.   oldsizex = sizex                :REM remember for next time
  120.  
  121.   IF CaretWin = entry THEN
  122.     CaretIcon = FNmin(CaretIcon, lines-1)
  123.     SYS "Wimp_SetCaretPosition",entry,CaretIcon,,,-1,CaretIndex
  124.   ENDIF
  125. ENDPROC
  126.  
  127. DEF FNopen(block, maxx, maxy, miny, indir)   :REM open an icon
  128.   block!8  = miny
  129.   IF maxx<>0: block!12 = maxx
  130.   block!16 = maxy
  131.   IF indir<>0: block!24 = indir              :REM point at text buffer
  132.   SYS "Wimp_CreateIcon" ,,block TO temp
  133. =temp
  134.  
  135. DEF PROCshut(icon)            :REM shut an icon
  136.   !b  = entry
  137.   b!4 = icon
  138.   SYS "Wimp_DeleteIcon",,b
  139. ENDPROC
  140.  
  141. REM ***********
  142. REM
  143. REM MenuSelect
  144. REM
  145. REM ***********
  146.  
  147. DEF PROCmenuselect(b)
  148.   CASE !b OF
  149.     WHEN 1:PROCsaveit($fname)      :REM save as
  150.     WHEN 2:                        :REM select another printer
  151.       IF b!4 <> -1 THEN
  152.         Printer$ = Make$(b!4)
  153.         PROCgrey(0)                :REM ungray any options for old printer
  154.         PROCsetcodes               :REM set up new printer codes
  155.         PROCgrey(1)                :REM gray any options not available
  156.         L%=0: R%=0
  157.         $SetUpTitle = "Options - "+Printer$
  158.         PROCredraw(setup,FALSE)    :REM show correct printer in title bar
  159.         PROCsaveprinter            :REM save printer choice on disk
  160.       ENDIF
  161.     WHEN 3: PROCexample            :REM print test sheet
  162.     WHEN 4: quit=TRUE              :REM quit
  163.   ENDCASE
  164.  
  165.   PROCgetpointer                   :REM redisplay menu if adjust used
  166.   IF buttons% AND 1 THEN
  167.     PROCquitmenu(X%,Y%)
  168.   ENDIF
  169. ENDPROC
  170.  
  171. DEF PROCsaveprinter                :REM save current printer choice on disk
  172.   ON ERROR LOCAL: ENDPROC          :REM if problem - forget it!
  173.   h%=OPENOUT("<Obey$Dir>.Printer")
  174.   BPUT#h%,Printer$+CHR$(10)
  175.   CLOSE#h%
  176. ENDPROC
  177.  
  178. REM ********
  179. REM
  180. REM Buttons
  181. REM
  182. REM ********
  183.  
  184. DEF PROCbuttons(b)
  185.   window  = b!12
  186.   icon    = b!16
  187.   buttons = b!8
  188.  
  189.   CASE window OF
  190.     WHEN -2                                      :REM icon bar
  191.       IF buttons=&02 THEN
  192.         PROCquitmenu(!b-64,298)                  :REM display menu
  193.       ELSE
  194.         PROCredraw(setup,TRUE)                   :REM open options window
  195.         PROCredraw(entry,TRUE)                   :REM open input window
  196.       ENDIF
  197.  
  198.     WHEN entry                                   :REM main display
  199.       CASE TRUE OF
  200.         WHEN buttons=&02                         :REM menu button pressed
  201.           PROCquitmenu(!b,b!4)                   :REM display menu
  202.  
  203.         WHEN (buttons=&01 OR buttons=&04)        :REM select button pressed
  204.           CASE icon OF
  205.             WHEN PrintBox
  206.                    IF FNbuffer=TRUE THEN
  207.                      PROCmargin(VAL($left),VAL($right))
  208.                      PROCprintit                   :REM Print
  209.                    ENDIF
  210.             WHEN OptionsBox
  211.                    PROCredraw(setup,TRUE)        :REM Options
  212.             WHEN ClearBox
  213.                    PROCclear                     :REM Clear text
  214.                    PROCredraw(entry, FALSE)      :REM refresh display
  215.                    SYS "Wimp_SetCaretPosition",entry,0,,,-1,-1
  216.           ENDCASE
  217.       ENDCASE
  218.  
  219.     WHEN setup                      :REM options window
  220.       IF buttons=&02 THEN
  221.         PROCquitmenu(!b,b!4)        :REM display menu
  222.       ELSE
  223.         PROCprint(FNsetstyle)       :REM send new codes to printer - this 
  224.                                     :REM looks good on printers with LEDs
  225.                                     :REM which show their settings.
  226.       ENDIF
  227.  
  228.     WHEN saveas                     :REM save window
  229.       CASE TRUE OF
  230.         WHEN (icon=dragicon AND (b!8 AND &50)<>0)  :REM icon dragged
  231.           PROCdragbox
  232.         WHEN icon=ok                               :REM ok pressed
  233.           PROCsaveit($fname)
  234.       ENDCASE
  235.   ENDCASE
  236. ENDPROC
  237.  
  238. DEF PROCprintit                    :REM send text to printer
  239.   PROCprint(FNsetstyle)            :REM send control codes
  240.  
  241.   FOR I%=0 TO lines-1              :REM then print each line directly
  242.     word$ = $(FNindir(entry, I%))  :REM from the icon buffer.
  243.     PROCprint(word$+nl$)
  244.   NEXT
  245. ENDPROC
  246.  
  247. DEF FNstate(icon)                  :REM is icon selected?
  248.   !b  = setup
  249.   b!4 = icon
  250.   SYS "Wimp_GetIconState",,b
  251. =((b!26 AND %00100000) = %00100000)
  252.  
  253. DEF PROCclear                      :REM clear all icon buffers of text.
  254.   FOR I%=0 TO 30
  255.     $(text+I%*80) = ""
  256.   NEXT
  257. ENDPROC
  258.  
  259. REM ****** FILE TRANSFER *************************
  260. REM
  261. REM 4 cases
  262. REM Me to file  - dragbox,dragdone,filesave,saveit
  263. REM File to me  - dataload
  264. REM Me to App   - dragbox,dragdone,,sendram
  265. REM App to Me   - savetous,getram
  266. REM
  267. REM **********************************************
  268.  
  269. DEF PROCreceive(b)
  270.   CASE b!16 OF
  271.     WHEN 0: quit=TRUE       :REM Shut down
  272.     WHEN 1: PROCsavetous(b) :REM Program wishes to save a file
  273.     WHEN 2: PROCfilesave(b) :REM Ready to save a file
  274.     WHEN 3: PROCdataload(b) :REM Load a file
  275.     WHEN 6: PROCsendram(b)  :REM Data pipe from me
  276.     WHEN 7: PROCgetram(b)   :REM Data pipe to me
  277.   ENDCASE
  278. ENDPROC
  279.  
  280. DEF PROCdragbox
  281.   !b = saveas                  :REM window handle
  282.   SYS "Wimp_GetWindowState",,b :REM get window position
  283.  
  284.   wex = b!4  - b!20            :REM min x - x scroll
  285.   wey = b!16 - b!24            :REM max y - y scroll
  286.   b!4 = dragicon               :REM icon handle
  287.   SYS "Wimp_GetIconState",,b   :REM get icon position
  288.  
  289.   b!4  = 5                     :REM Drag type - fixed size box
  290.   b!8  = b!8  + wex            :REM min x of initial box
  291.   b!12 = b!12 + wey            :REM min y of initial box
  292.   b!16 = b!16 + wex            :REM max x
  293.   b!20 = b!20 + wey            :REM max y
  294.   b!24 = 0                     :REM min x parent
  295.   b!28 = 0                     :REM min y parent
  296.   b!32 = &7FFFFFFF             :REM max x parent
  297.   b!36 = &7FFFFFFF             :REM max y parent
  298.   SYS "Wimp_DragBox",,b
  299.   newdrag=TRUE                 :REM note for sendram
  300. ENDPROC
  301.  
  302. DEF PROCdragdone
  303.   length=0                     :REM calculate size of text to send.
  304.   FOR I%=0 TO lines-1
  305.     length+=LEN($(FNindir(entry, I%)))+1
  306.   NEXT
  307.  
  308.   SYS "Wimp_GetPointerInfo",,b :REM block is for output
  309.   b!20=64                      :REM length of block
  310.   b!32=0                       :REM my ref (0=originating)
  311.   b!36=1                       :REM message action
  312.   b!40=b!12                    :REM window handle
  313.   b!44=b!16                    :REM icon handle
  314.   b!48=!b                      :REM destination x
  315.   b!52=b!4                     :REM destination y
  316.   b!56=length                  :REM size of file
  317.   b!60=&FFF                    :REM file type
  318.   $(b+64)=FNleaf($fname)+CHR$0 :REM file name, zero terminated
  319.   SYS "Wimp_SendMessage",17,b+20,b!12,b!16
  320.   myref=b!28                   :REM myref returned
  321. ENDPROC
  322.  
  323. DEF PROCfilesave(b)            :REM filing system ready to save file.
  324.   IF b!12=myref THEN
  325.     PROCsaveit(FNgname(b+44))
  326.  
  327.     b!12=b!8                   :REM say file saved OK.
  328.     b!16=3
  329.     SYS "Wimp_SendMessage",18,b,b!4
  330.   ENDIF
  331. ENDPROC
  332.  
  333. DEF PROCsaveit(name$)              :REM actually save the file
  334.   REM if name contains . it is file name.
  335.   REM if name contains < it is a RISC OS variable.
  336.   IF INSTR(name$,".") OR INSTR(name$,"<") THEN
  337.     $fname = name$                 :REM set name for next time
  338.  
  339.     I%=0
  340.     X%=OPENOUT name$
  341.   
  342.     FOR I%=0 TO lines-1 
  343.       word$ = $(FNindir(entry, I%))
  344.       BPUT#X%,word$
  345.     NEXT
  346.  
  347.     CLOSE #X%
  348.     OSCLI("STAMP "+name$)           :REM put date on it
  349.     OSCLI("SETTYPE "+name$+" &FFF") :REM text file
  350.  
  351.     !b1=saveas                      :REM window handle
  352.     SYS "Wimp_CloseWindow",,b1      :REM close save window
  353.     SYS "Wimp_CreateMenu",,-1       :REM close all menus
  354.   ELSE
  355.     $b1="      To save, drag the icon to a directory viewer"
  356.     SYS "Wimp_ReportError",b1,1,"!Teletext"
  357.   ENDIF
  358. ENDPROC
  359.  
  360. DEF PROCdataload(b)              :REM load from filing system
  361.   PROCclear                      :REM clear input window of text
  362.   ff$=FNgname(b+44)              :REM name of file
  363.   I%=0
  364.   X%=OPENIN ff$
  365.   
  366.   WHILE (NOT EOF#X%) AND (I%<30) 
  367.     temp$ = GET$#X%
  368.     $(text+I%*80) = LEFT$(temp$,80)
  369.     I%+=1
  370.   ENDWHILE
  371.  
  372.   CLOSE #X%
  373.  
  374.   REM if file was created just for me to load, delete it.
  375.   IF b!12=myref: *DELETE <Wimp$Scrap>
  376.  
  377.   b!12=b!8
  378.   b!16=4                         :REM say file has been loaded.
  379.   SYS "Wimp_SendMessage",17,b,b!4
  380.  
  381.   PROCredraw(entry, FALSE)       :REM refresh the display.
  382. ENDPROC
  383.  
  384. REM **************************************************
  385. REM
  386. REM SaveToUs, GetRam - a program wishes to save to us
  387. REM
  388. REM **************************************************
  389.  
  390. DEF PROCsavetous(b)      :REM b from message type 17,18
  391.   FOR F%=0 TO 43 STEP 4  :REM record block in case no reply
  392.     oldblk!F%=b!F%
  393.   NEXT
  394.  
  395.   fname$=FNgname(b+44)   :REM file name
  396.   flength=b!36           :REM length of file
  397.   ftype=b!40             :REM file type
  398.   rma=FNclaim(b!36)      :REM address of RMA memory
  399.  
  400.   b!12=b!8               :REM my ref?
  401.   b!16=6                 :REM send it to me as RAM 
  402.   b!20=rma               :REM start address
  403.   b!24=b!36              :REM length of block
  404.   SYS "Wimp_SendMessage",18,b,b!4
  405.  
  406.   myref=b!12             :REM myref?
  407.   retry=TRUE             :REM flag in case no reply to message 6
  408. ENDPROC
  409.  
  410. DEF PROCgetram(b)          :REM other app has sent data via RAM
  411.   IF b!24=flength THEN
  412.     b!12=b!8
  413.     b!16=6                 :REM message - send it to me as RAM 
  414.     SYS "Wimp_SendMessage",18,b,b!4
  415.   ELSE                     :REM data has been sent
  416.     PROCclear              :REM clear input window of text
  417.     fname$=FNleaf(fname$)  :REM get short file name
  418.  
  419.     I% = 0                 :REM loop round data, splitting into new lines
  420.     J% = 0                 :REM for newline(10) or return(13)
  421.     K% = 0
  422.     REPEAT
  423.       ?(text+I%*80+K%) = rma?J%
  424.       K%+=1
  425.       IF rma?J% = 13:    I%+=1: K%=0
  426.       IF rma?J% = 10:  ?(text+I%*80+K%-1)=13:  I%+=1: K%=0
  427.       IF K%>78:  ?(text+I%*80+K%) = 13: I%+=1: K%=0
  428.       J%+=1
  429.     UNTIL (I% > 32) OR (J% >= flength)
  430.  
  431.     PROCrelease(rma)                 :REM release RMA memory
  432.     PROCredraw(entry, FALSE)         :REM refresh the display
  433.   ENDIF
  434. ENDPROC 
  435.  
  436. REM ****************************************************
  437. REM
  438. REM NoAck is run when an app wants to save a file to me
  439. REM but they don't support data pipe
  440. REM
  441. REM ****************************************************
  442.  
  443. DEF PROCnoack(b)        :REM b from type 19 message
  444.   IF b!12=myref THEN
  445.     IF retry THEN
  446.       oldblk!12=oldblk!8
  447.       oldblk!16=2       :REM ready to save a file 
  448.       !oldblk=100
  449.       oldblk!36 = -1
  450.       $(oldblk+44)="<Wimp$Scrap>"+CHR$0   :REM temp file name
  451.       SYS "Wimp_SendMessage",17,oldblk,oldblk!4
  452.       myref=oldblk!8
  453.       retry=FALSE       :REM don't try again
  454.     ELSE
  455.       ERROR 1,"Pipe Broken"
  456.     ENDIF
  457.   ENDIF
  458. ENDPROC
  459.  
  460. REM ****************************************
  461. REM
  462. REM SendRam - an application wants my file
  463. REM
  464. REM ****************************************
  465.  
  466. DEF PROCsendram(b)
  467.   IF newdrag THEN
  468.     newdrag=FALSE
  469.     rma=FNclaim(length)             :REM address of RAM for transfer
  470.  
  471.     ptr=rma                         :REM put text into block of RAM
  472.     FOR I%=0 TO lines-1
  473.       temp$=$(FNindir(entry, I%))
  474.       $ptr = temp$
  475.       ptr+=LEN(temp$)+1
  476.       ?(ptr-1) = 10
  477.     NEXT
  478.  
  479.     start=rma                       :REM start address of data to send
  480.     cnd=start+length                :REM end address of data to send
  481.   ENDIF
  482.  
  483.   IF b!24 < cnd-start THEN
  484.     cend=start+b!24
  485.   ELSE
  486.     cend=cnd
  487.   ENDIF
  488.                                                    
  489.   REM the following line transfers my block of RAM to the other
  490.   REM applications block of RAM - I believe!
  491.   SYS "Wimp_TransferBlock",us,start,b!4,b!20,cend-start
  492.  
  493.   b!12=b!8
  494.   b!16=7              :REM message - load ram
  495.   b!24=cend-start     :REM amount sent
  496.   SYS "Wimp_SendMessage",18,b,b!4
  497.  
  498.   start=cend
  499.  
  500.   IF start=cnd: PROCrelease(rma) :REM release memory
  501.  
  502.   !b1=saveas                     :REM window handle
  503.   SYS "Wimp_CloseWindow",,b1     :REM close save window
  504.   SYS "Wimp_CreateMenu",,-1      :REM close all menus
  505. ENDPROC
  506.  
  507. DEF FNclaim(size)                :REM claim an area of RAM
  508.   SYS "OS_Module",6,,,size TO ,,ptr
  509. =ptr
  510.  
  511. DEF PROCrelease(RETURN ptr)      :REM release an area of RAM
  512.   IF ptr: SYS "OS_Module",7,,ptr
  513.   ptr=0
  514. ENDPROC
  515.  
  516. DEF FNleaf(path$)                :REM return short file name (no path)
  517.   WHILE INSTR(path$,".")
  518.     path$=MID$(path$,INSTR(path$,".")+1)
  519.   ENDWHILE
  520. =path$
  521.  
  522. DEF FNgname(ptr)                 :REM return zero terminated file name
  523.   LOCAL f$
  524.   WHILE ?ptr f$+=CHR$?ptr
  525.     ptr+=1
  526.   ENDWHILE
  527. =f$
  528.  
  529. REM ******************
  530. REM
  531. REM Error has occured
  532. REM
  533. REM ******************
  534.  
  535. DEF PROCerror
  536.   !b=ERR
  537.   $(b+4)=REPORT$+" at line "+STR$ERL+CHR$0
  538.   SYS "Wimp_ReportError", b, 3, "!OnePrint" TO ,response%
  539.   IF response%=2: PROCstop
  540. ENDPROC
  541.  
  542. DEF PROCstop                 :REM close task down neatly.
  543.   SYS "Wimp_CloseDown"
  544.   END
  545. ENDPROC
  546.  
  547. REM ***********************************************
  548. REM
  549. REM QuitMenu, Menu, MenuItem, MenuHead build menus
  550. REM
  551. REM ***********************************************
  552.  
  553. DEF PROCquitmenu(X%,Y%)      :REM construct menu
  554.   menuflag=0                 :REM redundant flag!
  555.  
  556.   P%=FNmenuhead(m,"One Print",200)
  557.   P%=FNmenuitem(P%,  0,  info,&7000021,        "Info",0,0,0)
  558.   P%=FNmenuitem(P%,  0,saveas,&7000021,        "Save",0,0,0)
  559.   P%=FNmenuitem(P%,  0,    m1,&7000021,     "Printer",0,0,0)
  560.   P%=FNmenuitem(P%,  0,    -1,&7000021,"Test Printer",0,0,0)
  561.   P%=FNmenuitem(P%,&80,    -1,&7000021,        "Quit",0,0,0)
  562.  
  563.   P%=FNmenuhead(m1,"Printers",200)  :REM construct Printer menu
  564.   FOR I%=0 TO Makes
  565.     flag=0: IF I%=Makes: flag=&80
  566.     IF Printer$=Make$(I%): flag=flag EOR &01
  567.  
  568.     P%=FNmenuitem(P%,flag,-1,&7000021,Make$(I%),0,0,0)
  569.   NEXT
  570.  
  571.   SYS "Wimp_CreateMenu",,m,X%,Y%  :REM blk,x select - 64,y
  572. ENDPROC
  573.  
  574. DEF FNmenuitem(m,a,b,c,text$,d,e,f)
  575.   !m=a            :REM menu flags (&80 = last item)
  576.   m!4=b           :REM sub menu pointer
  577.   m!8=c           :REM icon flags
  578.   IF text$<>"" THEN
  579.     $(m+12)=text$ :REM icon data
  580.   ELSE
  581.     m!12=d        :REM pointer to text
  582.     m!16=e        :REM pointer to validation string
  583.     m!20=f        :REM length of buffer
  584.   ENDIF
  585. =m+24
  586.  
  587. DEF FNmenuhead(m,text$,width)
  588.   $m=text$        :REM menu title
  589.   m!12=&70207     :REM colour
  590.   m!16=width      :REM width of menu items
  591.   m!20=40         :REM height of menu items
  592.   m!24=0          :REM vertical gap between items
  593. =m+28
  594.  
  595. DEF PROCgetpointer
  596.   SYS "Wimp_GetPointerInfo",,b
  597.   mousex%  = !b
  598.   mousey%  = b!4
  599.   buttons% = b!8
  600.   handle%  = b!12
  601.   icon%    = b!16
  602. ENDPROC
  603.  
  604. DEF PROCredraw(window,topwin)      :REM refresh window on display
  605.   IF topwin THEN
  606.     !b=window
  607.     SYS "Wimp_GetWindowState",,b   :REM get size of window
  608.     b!28=-1                        :REM position window on top
  609.     SYS "Wimp_OpenWindow",,b
  610.   ENDIF
  611.  
  612.   !b=window
  613.   SYS "Wimp_RedrawWindow",,b TO more%
  614.   WHILE more%
  615.     SYS "Wimp_GetRectangle",,b TO more%
  616.   ENDWHILE
  617. ENDPROC
  618.  
  619. REM ***********************
  620. REM
  621. REM Icon defines all icons
  622. REM
  623. REM ***********************
  624.  
  625. DEF FNicon(!b,b!4,b!8,b!12,b!16,b!20,text$,d,f)
  626.   IF text$<>"" THEN
  627.     $(b+24)=LEFT$(text$,12) :REM icon data
  628.   ELSE
  629.     b!24=d                  :REM pointer to text
  630.     b!28=-1                 :REM pointer to validation string
  631.     b!32=f                  :REM length of buffer
  632.   ENDIF
  633.  
  634.   SYS "Wimp_CreateIcon",,b TO handle
  635. =handle
  636.  
  637. DEF FNmax(x%,y%)
  638.   IF x%>y% :=x%
  639. =y%
  640.  
  641. DEF FNmin(x%,y%)
  642.   IF y%<x% :=y%
  643. =x%
  644.  
  645. DEF PROCwimp               : REM Set up WIMP environment
  646.   DIM b &1000, b1 100, m 400, m1 300
  647.   DIM PrintIcon 40, OptionsIcon 40, ClearIcon 40, TextIcon 40
  648.   DIM text 3000
  649.  
  650.   $b="TASK"
  651.   SYS "Wimp_Initialise",200,!b,"OnePrint" TO ,us
  652.   icon=FNicon(-1,0,10,68,78,&3002,"!OnePrint",0,0) :REM put icon on icon bar
  653.  
  654.   quit  = FALSE            :REM flag to stop
  655.   myref = 1234             :REM used in file transfer
  656.   DIM oldblk 256           :REM block used in file transfer
  657.   retry = FALSE            :REM flag for file transfer
  658.  
  659.   REM Load windows from template file *******************
  660.  
  661.   DIM ind% 2000            :REM indirected icon work space
  662.  
  663.   SYS "Wimp_OpenTemplate",,"<Obey$Dir>.Templates"
  664.   SYS "Wimp_LoadTemplate",,b,ind%,ind%+2000,-1,"Entry",0 TO ,,ind%
  665.   SYS "Wimp_CreateWindow",,b TO entry
  666.   SYS "Wimp_LoadTemplate",,b,ind%,ind%+1000,-1,"Info",0 TO ,,ind%
  667.   SYS "Wimp_CreateWindow",,b TO info
  668.   SYS "Wimp_LoadTemplate",,b,ind%,ind%+1000,-1,"xfer_send",0 TO ,,ind%
  669.   SYS "Wimp_CreateWindow",,b TO saveas
  670.   SYS "Wimp_LoadTemplate",,b,ind%,ind%+1000,-1,"SetUp",0 TO ,,ind%
  671.   SYS "Wimp_CreateWindow",,b TO setup
  672.   SYS "Wimp_CloseTemplate"
  673.  
  674.   !b  = info                      :REM set version number
  675.   b!4 = 4
  676.   SYS "Wimp_GetIconState",,b
  677.   $(b!28) = ver$
  678.  
  679.   !b  = saveas                    :REM get filename indirection
  680.   b!4 = 1
  681.   SYS "Wimp_GetIconState",,b
  682.   fname  = b!28
  683.   $fname = "Textfile"
  684.  
  685.   ok  = 0                         :REM ok icon number
  686.   dragicon = 2                    :REM dragicon number
  687.   PROCsprite("file_fff")          :REM open sprite on saveas window
  688.  
  689.   right=FNindir(setup, 7)         :REM indirection for right margin string
  690.   left =FNindir(setup, 29)        :REM ditto left
  691.  
  692.   PROCsetcodes                    :REM set up printer codes
  693.   PROCgrey(1)                     :REM gray any unavailable options
  694.  
  695.   !b  = setup
  696.   SYS "Wimp_GetWindowInfo",,b
  697.   SetUpTitle = b!76               :REM indirection of window title
  698.   $SetUpTitle = "Options - "+Printer$
  699.  
  700.   !b = entry                      :REM get initial size of entry window
  701.   SYS "Wimp_GetWindowState",,b
  702.   miny = b!8
  703.   maxy = b!16
  704.  
  705.   oldsizex = 0
  706.   lasticon = 0
  707.   PROCstore(lasticon, TextIcon)       :REM structure for data entry icons
  708.   depth  = TextIcon!16 - TextIcon!8
  709.   top    = TextIcon!8 
  710.   bottom = 127
  711.  
  712.   PrintBox   = 1                      :REM button icon numbers on
  713.   OptionsBox = 2                      :REM template file.
  714.   ClearBox   = 3
  715.  
  716.   PROCstore(PrintBox,PrintIcon)       :REM store structure for buttons.
  717.   PROCstore(OptionsBox,OptionsIcon)
  718.   PROCstore(ClearBox,ClearIcon)
  719.  
  720.   Depth = ClearIcon!16 - ClearIcon!8
  721.   PROCclear                           :REM clear data entry to blank
  722.   PROCresize                          :REM redraw window for initial size
  723. ENDPROC
  724.  
  725. DEF PROCsprite(temp$)             :REM open sprite on saveas window
  726.   !b1  = saveas
  727.   b1!4 = dragicon
  728.   SYS "Wimp_GetIconState",,b1
  729.  
  730.   !b = saveas
  731.   b!4 = dragicon
  732.   SYS "Wimp_DeleteIcon",,b
  733.  
  734.   b1!4  = saveas
  735.   b1?24 = &02
  736.   b1?25 = &60
  737.   $(b1+28) = temp$+CHR$(13)
  738.   SYS "Wimp_CreateIcon",,b1+4
  739. ENDPROC
  740.  
  741. DEF PROCstore(icon, RETURN block)  :REM store an icon structure in block
  742.   !block  = entry
  743.   block!4 = icon
  744.   SYS "Wimp_GetIconState",,block
  745.   
  746.   block!4 = entry
  747.   block = block+4
  748. ENDPROC
  749.  
  750. DEF FNindir(window, icon)         :REM find indirected string address
  751.   !b1  = window
  752.   b1!4 = icon
  753.   SYS "Wimp_GetIconState",,b1
  754. =b1!28
  755.  
  756. DEF PROCmargin(left%, right%)     :REM send printer codes for left and 
  757.                                   :REM right margins. Only send them
  758.                                   :REM if margins have changed, since some
  759.                                   :REM printers need a line feed to activate
  760.                                   :REM this!  eg  Cannon BJ-10e
  761.  
  762.   IF (L%<>left%) OR (R%<>right%) THEN
  763.     L%=left%
  764.     R%=right%
  765.  
  766.     IF Margin$="" THEN
  767.       PROCprint(LMargin$+CHR$(L%))
  768.       PROCprint(RMargin$+CHR$(R%))
  769.     ELSE
  770.       PROCprint(Margin$+CHR$(L%)+CHR$(R%)+nl$) 
  771.     ENDIF
  772.   ENDIF
  773. ENDPROC
  774.  
  775. DEFFNsetstyle                 :REM Set printer codes
  776.   P$ = Reset$
  777.  
  778.   IF FNstate(22) :P$+=NLQOn$
  779.  
  780.   IF FNstate(9)  :P$+=ExpandOn$
  781.   IF FNstate(10) :P$+=EliteOn$+ExpandOn$
  782.   IF FNstate(12) :P$+=EliteOn$
  783.   IF FNstate(13) :P$+=CondenseOn$
  784.   IF FNstate(14) :P$+=EliteOn$+CondenseOn$
  785.  
  786.   IF FNstate(16) :P$+=EmphOn$
  787.   IF FNstate(17) :P$+=BoldOn$
  788.   IF FNstate(18) :P$+=EmphOn$+BoldOn$
  789.  
  790.   IF FNstate(20) :P$+=ItalicOn$
  791.  
  792.   IF FNstate(24) :P$+=SuperOn$
  793.   IF FNstate(25) :P$+=SubOn$
  794.  
  795.   IF FNstate(27) :P$+=DoubOn$
  796.   IF FNstate(28) :P$+=QuadOn$
  797.  
  798.   IF FNstate(31) :P$+=Centre$
  799.   IF FNstate(8)  :P$+=Right$
  800. =P$
  801.  
  802. DEF PROCgrey(OnOff)
  803.   IF EmphOn$=""   :PROCgreyicon(16): PROCgreyicon(18)
  804.   IF BoldOn$=""   :PROCgreyicon(17): PROCgreyicon(18)
  805.   IF ItalicOn$="" :PROCgreyicon(19): PROCgreyicon(20)
  806.   IF NLQOn$=""    :PROCgreyicon(21): PROCgreyicon(22)
  807.   IF DoubOn$=""   :PROCgreyicon(26): PROCgreyicon(27)
  808.   IF QuadOn$=""   :PROCgreyicon(28)
  809.   IF Left$=""     :PROCgreyicon(30):PROCgreyicon(31):PROCgreyicon(8)
  810. ENDPROC
  811.  
  812. DEF PROCgreyicon(icon)
  813.   !b   = setup
  814.   b!4  = icon
  815.  
  816.   IF OnOff=1 THEN
  817.     b!8 = %10000000000000000000000
  818.   ELSE
  819.     b!8 = %00000000000000000000000
  820.   ENDIF
  821.  
  822.   b!12 = %10000000000000000000000
  823.   SYS "Wimp_SetIconState",,b
  824. ENDPROC
  825.  
  826. DEF PROCprint(a$)                   :REM send text to printer
  827.   *FX3,10
  828.   *FX6,254
  829.   PRINT a$;
  830.   *FX6,10
  831.   *FX3,0
  832. ENDPROC
  833.  
  834. DEF FNbuffer                        :REM printer on?
  835.   IF FNprinterOn: =TRUE
  836.  
  837.   REPEAT
  838.     !b=30
  839.     $(b+4)="Printer not ready"
  840.     SYS "Wimp_ReportError", b, 3, "!OnePrint" TO ,response%
  841.     IF response%=2: =FALSE             :REM user cancelled
  842.  
  843.     REM clear printer buffer (Cannon BJ10e seems to need this?)
  844.     *FX21,3
  845.   UNTIL FNprinterOn
  846. =TRUE
  847.  
  848. DEF FNprinterOn
  849.   startsize=ADVAL(-4)
  850.   *FX3,10
  851.   VDU 0,0                              :REM send a null code.
  852.   *FX3,0
  853.   time=TIME+5:REPEAT UNTIL TIME>time   :REM allow some time for printer
  854.   endsize=ADVAL(-4)                    :REM to swallow data.
  855.  
  856.   IF endsize>=startsize: =TRUE
  857. =FALSE
  858.  
  859. DEFFNchr(a%,b%,c%)                :REM contruct a string of control codes
  860.   IF c%=-1 AND b%=-1: =CHR$(a%)
  861.   IF c%=-1:=CHR$(a%)+CHR$(b%)
  862.   =CHR$(a%)+CHR$(b%)+CHR$(c%)
  863.  
  864. DEFPROCexample                    :REM example text
  865.   PROCmargin(0,80)                :REM set margins to full width
  866.   T$="This is ":I$=" characters per inch)"
  867.   IF FNbuffer=FALSE: ENDPROC
  868.   PROCprint(Reset$+ExpandOn$+T$+"expanded Pica (5 per inch)"+nl$)
  869.   PROCprint(Reset$+EliteOn$+ExpandOn$+T$+"expanded Elite (6 per inch)"+nl$)
  870.   PROCprint(Reset$+T$+"Pica (10"+I$+nl$)
  871.   PROCprint(Reset$+EliteOn$+T$+"Elite (12"+I$+nl$)
  872.   PROCprint(Reset$+CondenseOn$+T$+"condensed Pica (17"+I$+nl$)
  873.   PROCprint(Reset$+EliteOn$+CondenseOn$+T$+"condensed Elite (20"+I$+nl$)
  874.   PROCprint(Reset$+nl$)
  875.  
  876.   PROCprint(Reset$+T$+"single strike"+nl$)
  877.   PROCprint(Reset$+EmphOn$+T$+"emphasized printing"+nl$)
  878.   PROCprint(Reset$+BoldOn$+T$+"bold printing"+nl$)
  879.   PROCprint(Reset$+EmphOn$+T$+"emphasized and bold"+nl$)
  880.   PROCprint(Reset$+nl$)
  881.  
  882.   IF ItalicOn$<>"" :PROCprint(Reset$+ItalicOn$+T$+"italic style"+nl$)
  883.   PROCprint(Reset$+NLQOn$+T$+"NLQ (Near letter quality)"+nl$)
  884.   IF ItalicOn$<>"" :PROCprint(Reset$+NLQOn$+ItalicOn$+T$+"NLQ in italic style"+nl$)
  885.  
  886.   PROCprint(Reset$+nl$)
  887.   PROCprint(Reset$+T$+"normal ")
  888.   PROCprint(SuperOn$+T$+"superscript ")
  889.   PROCprint(SubOn$+T$+"subscript"+nl$)
  890.  
  891.   PROCprint(Reset$+CondenseOn$+T$+"condensed ")
  892.   PROCprint(SuperOn$+T$+"superscript ")
  893.   PROCprint(SubOn$+T$+"subscript"+nl$+nl$)
  894.  
  895.   PROCprint(FNsetstyle)                   :REM reset to options window
  896.   PROCmargin(VAL($left),VAL($right))      :REM reset margins
  897. ENDPROC
  898.  
  899. DEF PROCsetcodes
  900.   REM Set codes for printer
  901.   REM -1 means short codes 
  902.  
  903.   nl$          =CHR$(13)          :REM new line character
  904.   PicaOn$      =FNchr(27, 80,-1)
  905.   EliteOn$     =FNchr(27, 77,-1)
  906.   ExpandOn$    =FNchr(27, 87, 1)
  907.   ExpandOff$   =FNchr(27, 87, 0)
  908.   CondenseOn$  =FNchr(15, -1,-1)
  909.   CondenseOff$ =FNchr(18, -1,-1)
  910.   EmphOn$      =FNchr(27, 69,-1)
  911.   EmphOff$     =FNchr(27, 70,-1)
  912.   BoldOn$      =FNchr(27, 71,-1)
  913.   BoldOff$     =FNchr(27, 72,-1)
  914.   ItalicOn$    =FNchr(27, 52,-1)
  915.   ItalicOff$   =FNchr(27, 53,-1)
  916.   NLQOn$       =FNchr(27,120, 1)
  917.   NLQOff$      =FNchr(27,120, 0)
  918.   SuperOn$     =FNchr(27, 83, 0)
  919.   SubOn$       =FNchr(27, 83, 1)
  920.   SubOff$      =FNchr(27, 84,-1)
  921.   DoubOn$      =FNchr(27,104, 1)
  922.   QuadOn$      =FNchr(27,104, 2) 
  923.   DoubOff$     =FNchr(27,104, 0)
  924.   Left$        =FNchr(27, 97, 0)
  925.   Centre$      =FNchr(27, 97, 1)
  926.   Right$       =FNchr(27, 97, 2)
  927.   Margin$      = ""
  928.   LMargin$     =FNchr(27,108,-1)
  929.   RMargin$     =FNchr(27, 81,-1)
  930.  
  931.   REM you only need to set items that differ from defaults.
  932.   IF Printer$ = "Cannon BJ10e" THEN
  933.     PicaOn$      =FNchr(27,73,0)
  934.     EliteOn$     =FNchr(27,58,-1)
  935.     NLQOn$       =FNchr(27,73,2)
  936.     NLQOff$      =FNchr(27,73,0)
  937.     ItalicOn$    =""
  938.     ItalicOff$   =""
  939.     DoubOn$      =FNchr(27,91,64)+FNchr(4,0,0)+FNchr(0,34,2)
  940.     QuadOn$      =""
  941.     DoubOff$     =FNchr(27,91,64)+FNchr(4,0,0)+FNchr(0,17,1)
  942.     Margin$      =FNchr(27, 88,-1)
  943.     Left$        =""
  944.     Centre$      =""
  945.     Right$       =""
  946.   ENDIF
  947.  
  948.   REM you only need to set items that differ from defaults.
  949.   IF Printer$ = "Epson FX80" THEN
  950.     Left$        = ""
  951.     Centre$      = ""
  952.     Right$       = ""
  953.     DoubOn$      = ""
  954.     QuadOn$      = ""
  955.     DoubOff$     = ""
  956.   ENDIF
  957.  
  958.   REM most printers have a reset code, however to work on all printers
  959.   REM (well the 3 I have tried), it seems better to reset the printer by
  960.   REM this long winded method! 
  961.   Reset$ = DoubOff$ + PicaOn$ + ExpandOff$ + CondenseOff$ + EmphOff$ + BoldOff$ + ItalicOff$ + NLQOff$ + SubOff$ + Left$
  962. ENDPROC
  963.